home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
m2menu.zip
/
MENU2.MOD
< prev
next >
Wrap
Text File
|
1990-03-22
|
15KB
|
450 lines
MODULE menu2; (* Menu example, TopSpeed Modula-2 V 1.16, Ron Buelow 3/90 *)
FROM IO IMPORT WrChar, WrLn, WrStr, WrStrAdj;
FROM Str IMPORT Length;
FROM Window IMPORT Black, White, Clear, Close, DoubleFrame,
GotoXY, Open, WinDef, WinType;
IMPORT MenuIO;
CONST
DescLen = 40; (* max label length *)
Offset = 1;
NumMain = 10; (* total number of selections per menu *)
NumSub1 = 10;
NumSub2 = 10;
NumSub3 = 10;
NumSub4 = 10;
NumSub5 = 10;
NumSub6 = 10;
NumSub7 = 10;
NumSub8 = 10;
NumSub9 = 10;
NumSub10 = 10;
bel = 7C;
esc = 33C;
TYPE
xType = RECORD
ch: CHAR;
desc: ARRAY [0..DescLen] OF CHAR;
END;
VAR
MainMenu : ARRAY [0..NumMain-1] OF xType;
SubMenu1 : ARRAY [0..NumSub1-1] OF xType;
SubMenu2 : ARRAY [0..NumSub2-1] OF xType;
SubMenu3 : ARRAY [0..NumSub3-1] OF xType;
SubMenu4 : ARRAY [0..NumSub4-1] OF xType;
SubMenu5 : ARRAY [0..NumSub5-1] OF xType;
SubMenu6 : ARRAY [0..NumSub6-1] OF xType;
SubMenu7 : ARRAY [0..NumSub7-1] OF xType;
SubMenu8 : ARRAY [0..NumSub8-1] OF xType;
SubMenu9 : ARRAY [0..NumSub9-1] OF xType;
SubMenu10 : ARRAY [0..NumSub10-1] OF xType;
Xch, sc : CHAR;
(*********************************************************************)
(* Make a self-centering, self-wrapping moving bar menu *)
(*********************************************************************)
PROCEDURE MakeMenu(xArr: ARRAY OF xType): CHAR;
CONST
ScrDepth = 25;
ScrWidth = 80;
VAR width, depth, left, top, right, bottom, i : CARDINAL;
j, len, maxLength: CARDINAL;
getCH, result : CHAR;
MenuWin : WinType;
WD, smWD : WinDef;
xWidth: INTEGER;
BEGIN
maxLength := Length(xArr[0].desc);
FOR j := 1 TO HIGH(xArr) DO
len := Length(xArr[j].desc);
IF len > maxLength THEN
maxLength := len
END
END;
width := maxLength+6;
depth := HIGH(xArr)+2;
left := (ScrWidth-width) DIV 2;
right := left+width;
top := (ScrDepth-depth) DIV 3;
bottom := top+depth;
xWidth := -INTEGER(width);
WITH WD DO
X1 := left;
Y1 := top;
X2 := right;
Y2 := bottom;
Foreground := White;
Background := Black;
CursorOn := FALSE;
WrapOn := FALSE;
Hidden := FALSE;
FrameOn := TRUE;
FrameDef:= DoubleFrame;
FrameFore:= White;
FrameBack:= Black
END;(*WITH*)
MenuWin := Open(WD);
FOR i := 0 TO HIGH(xArr) DO
WITH xArr[i] DO
WrLn;
WrChar(' ');
WrChar(ch);
WrStr(" ");
WrStr(desc)
END(*WITH*)
END;(*FOR*)
LOOP
getCH := MenuIO.GetKey(sc);
CASE getCH OF
'0'..'9' : result := xArr[ORD(sc)-2].ch; EXIT
| esc : result := esc; EXIT
ELSE
WrChar(bel) (* honk if non-valid key is hit *)
END;(*CASE*)
END;(*LOOP*)
Close(MenuWin);
RETURN result
END MakeMenu;
(********************************************************************)
(* Menu labels *)
(********************************************************************)
PROCEDURE MenuLabelNumbers(VAR xArr: ARRAY OF xType);
BEGIN
xArr[0].ch := '1';
xArr[1].ch := '2';
xArr[2].ch := '3';
xArr[3].ch := '4';
xArr[4].ch := '5';
xArr[5].ch := '6';
xArr[6].ch := '7';
xArr[7].ch := '8';
xArr[8].ch := '9';
xArr[9].ch := '0'
END MenuLabelNumbers;
PROCEDURE MainMenuLabel(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "Item One";
xArr[1].desc := "Item Two";
xArr[2].desc := "Item Three";
xArr[3].desc := "Item Four";
xArr[4].desc := "Item Five";
xArr[5].desc := "Item Six";
xArr[6].desc := "Item Seven";
xArr[7].desc := "Item Eight";
xArr[8].desc := "Item Nine";
xArr[9].desc := "Item Ten"
END MainMenuLabel;
PROCEDURE M1(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu One, Selection One";
xArr[1].desc := "SubMenu One, Selection Two";
xArr[2].desc := "SubMenu One, Selection Three";
xArr[3].desc := "SubMenu One, Selection Four";
xArr[4].desc := "SubMenu One, Selection Five";
xArr[5].desc := "SubMenu One, Selection Six";
xArr[6].desc := "SubMenu One, Selection Seven";
xArr[7].desc := "SubMenu One, Selection Eight";
xArr[8].desc := "SubMenu One, Selection Nine";
xArr[9].desc := "SubMenu One, Selection Ten"
END M1;
PROCEDURE M2(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Two, Selection One";
xArr[1].desc := "SubMenu Two, Selection Two";
xArr[2].desc := "SubMenu Two, Selection Three";
xArr[3].desc := "SubMenu Two, Selection Four";
xArr[4].desc := "SubMenu Two, Selection Five";
xArr[5].desc := "SubMenu Two, Selection Six";
xArr[6].desc := "SubMenu Two, Selection Seven";
xArr[7].desc := "SubMenu Two, Selection Eight";
xArr[8].desc := "SubMenu Two, Selection Nine";
xArr[9].desc := "SubMenu Two, Selection Ten"
END M2;
PROCEDURE M3(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Three, Selection One";
xArr[1].desc := "SubMenu Three, Selection Two";
xArr[2].desc := "SubMenu Three, Selection Three";
xArr[3].desc := "SubMenu Three, Selection Four";
xArr[4].desc := "SubMenu Three, Selection Five";
xArr[5].desc := "SubMenu Three, Selection Six";
xArr[6].desc := "SubMenu Three, Selection Seven";
xArr[7].desc := "SubMenu Three, Selection Eight";
xArr[8].desc := "SubMenu Three, Selection Nine";
xArr[9].desc := "SubMenu Three, Selection Ten"
END M3;
PROCEDURE M4(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Four, Selection One";
xArr[1].desc := "SubMenu Four, Selection Two";
xArr[2].desc := "SubMenu Four, Selection Three";
xArr[3].desc := "SubMenu Four, Selection Four";
xArr[4].desc := "SubMenu Four, Selection Five";
xArr[5].desc := "SubMenu Four, Selection Six";
xArr[6].desc := "SubMenu Four, Selection Seven";
xArr[7].desc := "SubMenu Four, Selection Eight";
xArr[8].desc := "SubMenu Four, Selection Nine";
xArr[9].desc := "SubMenu Four, Selection Ten"
END M4;
PROCEDURE M5(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Five, Selection One";
xArr[1].desc := "SubMenu Five, Selection Two";
xArr[2].desc := "SubMenu Five, Selection Three";
xArr[3].desc := "SubMenu Five, Selection Four";
xArr[4].desc := "SubMenu Five, Selection Five";
xArr[5].desc := "SubMenu Five, Selection Six";
xArr[6].desc := "SubMenu Five, Selection Seven";
xArr[7].desc := "SubMenu Five, Selection Eight";
xArr[8].desc := "SubMenu Five, Selection Nine";
xArr[9].desc := "SubMenu Five, Selection Ten"
END M5;
PROCEDURE M6(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Six, Selection One";
xArr[1].desc := "SubMenu Six, Selection Two";
xArr[2].desc := "SubMenu Six, Selection Three";
xArr[3].desc := "SubMenu Six, Selection Four";
xArr[4].desc := "SubMenu Six, Selection Five";
xArr[5].desc := "SubMenu Six, Selection Six";
xArr[6].desc := "SubMenu Six, Selection Seven";
xArr[7].desc := "SubMenu Six, Selection Eight";
xArr[8].desc := "SubMenu Six, Selection Nine";
xArr[9].desc := "SubMenu Six, Selection Ten"
END M6;
PROCEDURE M7(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Seven, Selection One";
xArr[1].desc := "SubMenu Seven, Selection Two";
xArr[2].desc := "SubMenu Seven, Selection Three";
xArr[3].desc := "SubMenu Seven, Selection Four";
xArr[4].desc := "SubMenu Seven, Selection Five";
xArr[5].desc := "SubMenu Seven, Selection Six";
xArr[6].desc := "SubMenu Seven, Selection Seven";
xArr[7].desc := "SubMenu Seven, Selection Eight";
xArr[8].desc := "SubMenu Seven, Selection Nine";
xArr[9].desc := "SubMenu Seven, Selection Ten"
END M7;
PROCEDURE M8(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Eight, Selection One";
xArr[1].desc := "SubMenu Eight, Selection Two";
xArr[2].desc := "SubMenu Eight, Selection Three";
xArr[3].desc := "SubMenu Eight, Selection Four";
xArr[4].desc := "SubMenu Eight, Selection Five";
xArr[5].desc := "SubMenu Eight, Selection Six";
xArr[6].desc := "SubMenu Eight, Selection Seven";
xArr[7].desc := "SubMenu Eight, Selection Eight";
xArr[8].desc := "SubMenu Eight, Selection Nine";
xArr[9].desc := "SubMenu Eight, Selection Ten"
END M8;
PROCEDURE M9(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Nine, Selection One";
xArr[1].desc := "SubMenu Nine, Selection Two";
xArr[2].desc := "SubMenu Nine, Selection Three";
xArr[3].desc := "SubMenu Nine, Selection Four";
xArr[4].desc := "SubMenu Nine, Selection Five";
xArr[5].desc := "SubMenu Nine, Selection Six";
xArr[6].desc := "SubMenu Nine, Selection Seven";
xArr[7].desc := "SubMenu Nine, Selection Eight";
xArr[8].desc := "SubMenu Nine, Selection Nine";
xArr[9].desc := "SubMenu Nine, Selection Ten"
END M9;
PROCEDURE M10(VAR xArr: ARRAY OF xType);
BEGIN
MenuLabelNumbers(xArr);
xArr[0].desc := "SubMenu Ten, Selection One";
xArr[1].desc := "SubMenu Ten, Selection Two";
xArr[2].desc := "SubMenu Ten, Selection Three";
xArr[3].desc := "SubMenu Ten, Selection Four";
xArr[4].desc := "SubMenu Ten, Selection Five";
xArr[5].desc := "SubMenu Ten, Selection Six";
xArr[6].desc := "SubMenu Ten, Selection Seven";
xArr[7].desc := "SubMenu Ten, Selection Eight";
xArr[8].desc := "SubMenu Ten, Selection Nine";
xArr[9].desc := "SubMenu Ten, Selection Ten"
END M10;
(********************************************************************)
(* Execute menu selections *)
(********************************************************************)
PROCEDURE MenuAction(VAR xArr: ARRAY OF xType);
BEGIN
CASE Xch OF
'1': Xch := MakeMenu(SubMenu1);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 1");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '2': Xch := MakeMenu(SubMenu2);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 2");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '3': Xch := MakeMenu(SubMenu3);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 3");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '4': Xch := MakeMenu(SubMenu4);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 4");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '5': Xch := MakeMenu(SubMenu5);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 5");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '6': Xch := MakeMenu(SubMenu6);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 6");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '7': Xch := MakeMenu(SubMenu7);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 7");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '8': Xch := MakeMenu(SubMenu8);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 8");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '9': Xch := MakeMenu(SubMenu9);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 9");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
| '0': Xch := MakeMenu(SubMenu10);
CASE Xch OF
'0'..'9' : Clear;
WrStr("SubMenu 10");
WrStr(", Selection ");
WrChar(Xch);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
END(*CASE*)
END MenuAction;
(* Run program *)
BEGIN
MainMenuLabel(MainMenu); (* initialize menus *)
M1(SubMenu1);
M2(SubMenu2);
M3(SubMenu3);
M4(SubMenu4);
M5(SubMenu5);
M6(SubMenu6);
M7(SubMenu7);
M8(SubMenu8);
M9(SubMenu9);
M10(SubMenu10);
LOOP
Clear;
GotoXY(30,3);
WrStr("<Esc> key exits program");
GotoXY(11,18);
WrStr("Press the number (top row number key) of desired selection > ");
Xch := MakeMenu(MainMenu);
IF Xch = esc THEN EXIT END;(*IF*)
MenuAction(MainMenu); (* execute selection *)
END;(*LOOP*)
Clear
END menu2.